00010	BEGIN
00020	DEFINE ⊂="COMMENT",CR="'15",LF="'12", CRLF="CR&LF",TB="'11";
00025	REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00030	REQUIRE "KIPLA2.REL[KI,ALS]" LOAD_MODULE;
00040	REQUIRE "FIXUPA.REL[X,ALS]" LIBRARY;
00050	REQUIRE "IO.REL[X,ALS]" LIBRARY;
00060	REQUIRE "SUIO.REL[X,ALS]" LIBRARY;
00070	REQUIRE "LIB.REL[NET,NJM]" LIBRARY;
00080	EXTERNAL FORTRAN PROCEDURE KIPLAY;
00085	INTEGER ARRAY DPYBUF[0:8192];
00087	INTEGER ARRAY DATA[0:511];
00090	INTEGER ARRAY NAMES[0:100];
00100	INTEGER ARRAY DUMMY[1:2];
00110	INTEGER ARRAY NAME[0:5];
00120	INTEGER CHAN1,CHAN2,CHAN3,CHAN4,
00122	    NEW,I,J,K,L,V,LP,EOF,PP,SEGNAM,POINTX,PT0,PT1,PT2;
00125	INTEGER ARRAY PT[0:8];
00130	STRING READ,READ2,READ3;
00140	BOOLEAN ER;
00150	
00160	PROCEDURE SAY;
00170	BEGIN "SAY"
00180	
00190	INTEGER I,J;
00200	STRING READ2,READ3;
00210	
00220	READ3←"";
00230	FOR I←1 STEP 1 UNTIL 5 DO BEGIN
00240	  FOR J←1 STEP 1 UNTIL 5 DO BEGIN
00250	    READ3←READ3&READ[1 TO 1];
00260	    READ←READ[2 TO 20];
00270	    END;
00280	  NAME[I]←CVASC(READ3);
00290	  READ3←"";
00300	  END;
00310	
00320	START_CODE '047000400037; MOVEM 0,SEGNAM; '047040400017; END;
00330	⊂ Get segment name and detach;
00340	  KIPLAY(NAME[1],DUMMY[1]);
00350	START_CODE MOVE 0,SEGNAM; '047000400016; JFCL; END;
00360	⊂ Reattach segment so exit will be in order;
00370	END "SAY";
00380	
00390	
00400	PROCEDURE SHUFFLE;
00410	BEGIN "SHUF"
00420	INTEGER I,J,K;
00430	
00440	AIVECT(-640,386);
00450	I←DPYPTR-PT1;		⊂ Words to save;
00460	J←PT1-PT0;		⊂ Words to overwrite;
00470	for k←1 step 1 until i do dpybuf[k+3]←dpybuf[k+3+j];
00480	for k←i+1 step 1 until j+1 do dpybuf[k+3]←1;
00490	PT1←DPYPTR←PT0+I;
00500	END "SHUF";
00510	
00520	
00530	PROCEDURE PLOT;
00540	BEGIN "PLOT"
00550	INTEGER I,J,K,L,JP,LP,II,JJ;
00560	
00570	WHILE EOF=0 DO BEGIN
00575	  CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,0,2,0,0,0);
00577	  ENTER(CHAN3,"TMP1.TMP",0); READ←"TMP1.TMP";
00580	  FOR I←1 STEP 1 UNTIL 6 DO BEGIN
00590	   FOR J←1 STEP 1 UNTIL 5 DO BEGIN
00600	      ARRYIN(CHAN1,DATA[0],512);
00605	      ARRYOUT(CHAN3,DATA[0],512);
00610	      FOR K←0 STEP 2 UNTIL 510 DO BEGIN
00620	        L←LDB(POINT(12,DATA[K],11)); IF L>2047 THEN L←L-4096; L←L%16;
00630	        LP←L-JP; RVECT(1,LP); JP←L;
00640	        END;
00650	      END;
00660	    RIVECT(-640,-LP); RIVECT(-640,-128);
00670	    PT[I]←DPYPTR;
00680	    END;
00682	DPYSST(":0");
00684	FOR I←1 STEP 1 UNTIL 6 DO BEGIN
00686	  RIVECT(224,0); DPYSST(":"&CVS(I)); END;
00687	
00690	  DPYOUT(0); PTOCHW(0,'10120);
00691	OUTSTR("Portion shown says-"&CRLF);
00693	CLOSE(CHAN3); ⊂  SAY;
00694	OUTSTR("CR to continue"&CRLF);
00695	INCHWL;
00697	PT1←DPYPTR; SHUFFLE;
00700	  END;
00710	
00720	END "PLOT";
00730	
00740	
00800	TYPLOC(-384,-512); DPYSET(DPYBUF); 
00810	AIVECT(-640,448); PT0←DPYPTR;
01000	
01010	OUTSTR("This program allows one to hear a file, to rename it and to add the"
01020	   &CRLF&TB&
01030	    " new file name to the list (in sixbit) in file KILIST.SIX"&CRLF);
01040	
01050	OUTSTR("A space only as old name is taken to mean LISTEN.TMP"&CRLF
01060	  &"A ? will cause the list in KILIST.SIX to be typed"&CRLF
01070	      &"A CR only terminates the session"&CRLF);
01080	CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4;
01090	START_CODE MOVE 0,['325004000000]; '047000400110; END;
01100	
01110	    CLOSE(CHAN2); OPEN (CHAN2,"DSK",'10,2,0,0,0,EOF);
01120	    LOOKUP(CHAN2,"KILIST.SIX[KI,ALS]",ER);
01130	    ARRYIN(CHAN2,NAMES[0],100);
01140	
01150	WHILE TRUE DO BEGIN "LOOP"
01160	  OUTSTR(CRLF&"Type the old file name (with extension) ");
01170	  ER←1; WHILE ER DO BEGIN "OLD"
01180	    IF ( READ←INCHWL)="" THEN DONE "LOOP";
01190	    IF READ=" " THEN READ←"LISTEN.TMP";
01200	
01210	    IF READ="?" THEN BEGIN
01220	      OUTSTR(CRLF& "The following files are listed)"&CRLF&LF);
01230	      FOR I←0 STEP 1 UNTIL 99 DO BEGIN
01240	        IF NAMES[I]=0 THEN DONE;
01250	        OUTSTR(CVXSTR(NAMES[I])&".SAY"&CRLF);
01260	        END;
01270	      CONTINUE "LOOP";
01280	      END;
01290	
01300	    CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,1,1,0,0,EOF);
01310	    LOOKUP(CHAN1,READ,ER);
01320	    IF ER THEN OUTSTR("File "&READ&" could not be found. "
01330	      &CRLF&"Try again ")
01340	    ELSE DONE;
01350	    END "OLD";
01360	
01370	⊂ SAY;
01375	PLOT;
01380	
     

00790	  WHILE TRUE DO BEGIN "NEWN"
00800	  OUTSTR("Now type new name"&CRLF&
00810	      " (CR only leaves old name unchanged and unrecorded) ");
00820	    IF ( READ2←INCHWL)="" THEN CONTINUE "LOOP";
00830	
00840	    IF READ2="?" THEN BEGIN
00850	      OUTSTR(CRLF& "The following files are listed)"&CRLF&LF);
00860	      FOR I←0 STEP 1 UNTIL 99 DO BEGIN
00870	        IF NAMES[I]=0 THEN DONE;
00880	        OUTSTR(CVXSTR(NAMES[I])&".SAY"&CRLF);
00890	        END;
00900	      CONTINUE "NEWN";
00910	      END;
00920	
00930	    READ3←"";
00940	
00950	    FOR I←0 STEP 1 UNTIL 5 DO BEGIN
00960	      IF READ2[1 TO 1]="." THEN DONE;
00970	      READ3←READ3&READ2[1 TO 1]; READ2←READ2[2 TO 5]; END;
00980	
00990	    NEW←CVSIX(READ3);
01000	
01010	    FOR I←0 STEP 1 UNTIL 99 DO BEGIN
01020	      IF NAMES[I]=0 THEN DONE "NEWN";
01030	      IF NAMES[I]=NEW THEN BEGIN
01040	        OUTSTR("New name already has been used"
01050	         &CRLF&"Try again or CR to void request "&CRLF);
01060	        DONE;
01070	        END;
01080	      END;
01090	    END "NEWN";
01100	
01110	  NAMES[I]←NEW;
01120	
01130	  CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,0,2,0,0,0);
01140	  ENTER(CHAN2,"KILIST.SIX[KI,ALS]",0);
01150	  ARRYOUT(CHAN2,NAMES[0],100);
01160	  CLOSE(CHAN2);
01170	  
01180	  CLOSE(CHAN1); RENAME(CHAN1,READ3&".SAY",0,0);
01190	  RELEASE(CHAN1);
01200	  END "LOOP";
01210	
01220	START_CODE MOVE 0,['325000000000]; '047000400110; END;
01230	
01240	END;